home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 3 / Gold Medal Software - Volume 3 (Gold Medal) (1994).iso / bbsutils / pegand2a.arj / PEGAND2.PPE (.txt) < prev    next >
PCBoard Programming Language Executable  |  1994-03-01  |  10KB  |  344 lines
  1. ;------------------------------------------------------------------------------
  2. ;                                                   .ss.
  3. ;                                                   `²²'
  4. ;             .,sS$Ss,,s$  .,sS$$$Ss.  .,sS$Ss,,s$ .ss.  .sSs.
  5. ;           .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
  6. ;           $$$'   .$$$' $$$²Sçsµ²' .$$$'   .$$$'.$$$' .$$$'  `$$b.
  7. ;           $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$'    ;$$$
  8. ;           `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
  9. ;                                    .sS²°$$$²²°"'       d²°'
  10. ;                                  .$$²  .$$'
  11. ;                                  $$$.,d$$'
  12. ;                                  `²S$$S²'
  13. ;------------------------------------------------------------------------------
  14. ; P.P.L.X. 2.OO                          (C)1996 - Lone Runner / AEGiS CoRP'96 
  15. ;------------------------------------------------------------------------------
  16. ; PPE 2.OO (plain) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Integer  INTEGER001
  20.     Integer  INTEGER002
  21.     Integer  INTEGER003
  22.     Integer  INTEGER004
  23.     Integer  INTEGER005
  24.     Integer  INTEGER006
  25.     Integer  INTEGER007
  26.     Integer  INTEGER008
  27.     Integer  INTEGER009
  28.     Integer  INTEGER010
  29.     Integer  INTEGER011
  30.     Integer  INTEGER012
  31.     String   TSTRING001(100)
  32.     String   TSTRING002(100)
  33.     String   TSTRING003(100)
  34.     String   TSTRING004(100)
  35.     String   TSTRING005(100)
  36.     String   STRING006
  37.     String   TSTRING007(100)
  38.     String   STRING008
  39.     String   STRING009
  40.     String   TSTRING010(100)
  41.     String   TSTRING011(100)
  42.     String   TSTRING012(100)
  43.     String   TSTRING013(100)
  44.     String   STRING014
  45.     String   TSTRING015(100)
  46.     String   STRING016
  47.     String   STRING017
  48.     String   STRING018
  49.     String   STRING019
  50.     String   STRING020
  51.     String   TSTRING021(100)
  52.     String   STRING022
  53.  
  54. ;------------------------------------------------------------------------------
  55.  
  56.     For INTEGER001 = 1 To 2
  57.         RdUNet INTEGER001
  58.         TSTRING001(INTEGER001) = UN_Name()
  59.         TSTRING002(INTEGER001) = RTrim(UN_Name(), " ")
  60.         TSTRING003(INTEGER001) = RTrim(UN_City(), " ")
  61.         TSTRING004(INTEGER001) = UN_Stat()
  62.         TSTRING005(INTEGER001) = RTrim(UN_Oper(), " ")
  63.     Next
  64.     Gosub LABEL003
  65.     TSTRING004(PcbNode()) = "WHO"
  66.     PrintLn 
  67.     PrintLn 
  68.     PrintLn "@X70 ┌@X7F───────────────────────────────────────────────────────────────────────────@X70┐ @X0F"
  69.     PrintLn "@X70 @X78│                  @XF0* @X74WHO'S ON * PEGANODE ACTIVITY REPORT @XF0*                  @X7F│ @X0F"
  70.     PrintLn "@X70 @X78│@X74N@X78ode                   @XFEUNREGISTERED EVALUATION COPY                 @X74T@X78ime  @X7F │ @X0F"
  71.     PrintLn "@X70 @X78│ @X74N@X78o.       @X74C@X78ALLER            @X74F@X78ROM                @X74A@X78CTIVITY           @X74L@X78eft   @X7F│ @X0F"
  72.     PrintLn "@X70 @X78│──── ────────────────── ─────────────── ───────────────────────── ──────── @X7F│ @X0F"
  73.     For INTEGER002 = 1 To 2
  74.         STRING019 = I2S(INTEGER002, 10)
  75.         STRING016 = "\PEGANODE\PEGTIME." + STRING019
  76.         If (Exist(STRING016)) Goto LABEL001
  77.         TSTRING007(INTEGER002) = ""
  78.         Goto LABEL002
  79.         :LABEL001
  80.         FOpen 1, STRING016, 0, 0
  81.         FGet 1, INTEGER010
  82.         FGet 1, STRING017
  83.         FClose 1
  84.         For INTEGER007 = 1 To 7
  85.             STRING020 = Mid(STRING017, INTEGER007, 1)
  86.             Select Case (STRING020)
  87.                 Case "m"
  88.                     Break
  89.                 Case "("
  90.                     STRING020 = ""
  91.             End Select
  92.             STRING018 = STRING018 + STRING020
  93.         Next
  94.         INTEGER012 = S2I(STRING018, 10)
  95.         INTEGER011 = INTEGER012 - (Time() - INTEGER010) / 60
  96.         TSTRING007(INTEGER002) = ""
  97.         TSTRING007(INTEGER002) = I2S(INTEGER011, 10)
  98.         TSTRING007(INTEGER002) = LTrim(RTrim(TSTRING007(INTEGER002), " "), " ")
  99.         STRING018 = ""
  100.         Gosub LABEL007
  101.         If (TSTRING004(INTEGER002) == "WHO") TSTRING007(INTEGER002) = "@TIMELEFT@"
  102.         :LABEL002
  103.         TSTRING005(INTEGER002) = RTrim(TSTRING005(INTEGER002), " ")
  104.         TSTRING005(INTEGER002) = LTrim(TSTRING005(INTEGER002), " ")
  105.         STRING006 = INTEGER002
  106.         If (INTEGER002 < 10) Then
  107.             STRING006 = " " + STRING006
  108.         ElseIf (INTEGER002 >= 10) Then
  109.             STRING006 = STRING006
  110.         Endif
  111.         If (TSTRING004(INTEGER002) == "WHO") Then
  112.             PrintLn "@X70 @X78│@POS:4@@X74", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @POS:44@@X78Viewing @X74PEGANODE @POS:69@@X71@TIMELEFT:3R@@X70 @POS:73@Min @POS:77@@X7F │ @X0F"
  113.             Continue
  114.         Endif
  115.         If (TSTRING004(INTEGER002) == "") Then
  116.             PrintLn "@X70 @X78│@X74@POS:4@", STRING006, "@X78@POS:8@Unavailable Node @POS:77@ @X7F│ @X0F"
  117.             Continue
  118.         Endif
  119.         If (TSTRING004(INTEGER002) == " ") Then
  120.             PrintLn "@X70 @X78│@X74@POS:4@", STRING006, "@POS:8@@X78Available Node @POS:77@ @X7F│ @X0F"
  121.             Continue
  122.         Endif
  123.         If (TSTRING004(INTEGER002) == "O") Then
  124.             PrintLn "@X70 @X78│@X74@POS:4@", STRING006, "@POS:8@@X7FLogging On             @POS:77@ │ @X0F"
  125.             Continue
  126.         Endif
  127.         If (TSTRING004(INTEGER002) == "D") Then
  128.             TSTRING002(INTEGER002) = RTrim(TSTRING002(INTEGER002), " ")
  129.             INTEGER004 = Len(TSTRING002(INTEGER002))
  130.             TSTRING005(INTEGER002) = RTrim(TSTRING005(INTEGER002), " ")
  131.             INTEGER003 = Len(TSTRING005(INTEGER002))
  132.             Gosub LABEL004
  133.             TSTRING015(INTEGER002) = "@X7CDr: @X7B" + TSTRING005(INTEGER002)
  134.             PrintLn "@X70 @X78│@POS:4@@X74", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), "@POS:44@", TSTRING015(INTEGER002), "@X71@POS:69@", TSTRING007(INTEGER002), "@X70 @POS:73@Min @POS:77@ @X7F│ @X0F"
  135.             Continue
  136.         Endif
  137.         If (TSTRING004(INTEGER002) == "A") Then
  138.             TSTRING005(INTEGER002) = "Available For Chat"
  139.             PrintLn "@X70 @X78│@POS:4@@X74", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @POS:28@@X7E", TSTRING003(INTEGER002), " @X7F@POS:44@", TSTRING005(INTEGER002), "@X71@POS:69@", TSTRING007(INTEGER002), "@X70 @POS:73@Min@POS:77@ @X7F│ @X0F"
  140.             Continue
  141.         Endif
  142.         If (TSTRING004(INTEGER002) == "T") Then
  143.             Gosub LABEL005
  144.             Gosub LABEL006
  145.             Continue
  146.         Endif
  147.         If (TSTRING004(INTEGER002) == "S") Then
  148.             TSTRING005(INTEGER002) = "Answering Script"
  149.             PrintLn "@X70 @X78│@X74@POS:4@", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X76@POS:44@", TSTRING005(INTEGER002), "@POS:69@@X71", TSTRING007(INTEGER002), "@X70 @POS:73@Min@POS:77@ @X7F│ @X0F"
  150.             Continue
  151.         Endif
  152.         If (TSTRING004(INTEGER002) == "N") Then
  153.             PrintLn "@X70 @X78│@POS:4@@X74", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X74@POS:44@Running Event      @POS:77@ @X7F│ @X0F"
  154.             Continue
  155.         Endif
  156.         If (TSTRING004(INTEGER002) == "L") Then
  157.             PrintLn "@X70 @X78│@POS:4@@X74", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X74@POS:44@Logoff Pending     @POS:77@ @X7F│ @X0F"
  158.             Continue
  159.         Endif
  160.         If (TSTRING004(INTEGER002) == "R") Then
  161.             PrintLn "@X70 @X78│@POS:4@@X74", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X74@POS:44@DOS Recycle Pending@POS:77@ @X7F│ @X0F"
  162.             Continue
  163.         Endif
  164.         If (TSTRING004(INTEGER002) == "V") Then
  165.             PrintLn "@X70 @X78│@POS:4@@X74", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X74@POS:44@No Caller On Line  @POS:77@ @X7F│ @X0F"
  166.             Continue
  167.         Endif
  168.         If (TSTRING004(INTEGER002) == "W") Then
  169.             PrintLn "@X70 @X78│@POS:4@@X74", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X74@POS:44@Drop To DOS Pending@POS:77@ @X7F│ @X0F"
  170.             Continue
  171.         Endif
  172.         If (TSTRING004(INTEGER002) == "C") Then
  173.             PrintLn "@X70 @X78│@POS:4@@X74", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X74@POS:44@Chatting With Sysop@POS:69@@X71", TSTRING007(INTEGER002), "@X70@POS:73@Min@POS:77@ @X7F│ @X0F"
  174.             Continue
  175.         Endif
  176.         If (TSTRING004(INTEGER002) == "F") Then
  177.             PrintLn "@X70 @X78│@POS:4@@X74", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X75@POS:44@", TSTRING005(INTEGER002), "@X71@POS:69@", TSTRING007(INTEGER002), "@X70 @POS:73@Min@POS:77@ @X7F│ @X0F"
  178.             Continue
  179.         Endif
  180.         If (TSTRING004(INTEGER002) == "G") Then
  181.             PrintLn "@X70 @X78│@POS:4@@X74", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X7A@POS:44@Chatting With Group@POS:69@@X71", TSTRING007(INTEGER002), "@X70 @POS:73@Min@POS:77@ @X7F│ @X0F"
  182.             Continue
  183.         Endif
  184.         If (TSTRING004(INTEGER002) == "E") Then
  185.             PrintLn "@X70 @X78│@POS:4@@X74", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X71@POS:44@Entering A Message@X71@POS:69@", TSTRING007(INTEGER002), "@X70 @POS:73@Min@POS:77@ @X7F│ @X0F"
  186.             Continue
  187.         Endif
  188.         If (TSTRING004(INTEGER002) == "M") Then
  189.             PrintLn "@X70 @X78│@POS:4@@X74", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X71@POS:44@Reading A Message@POS:69@", TSTRING007(INTEGER002), "@X70 @POS:73@Min@POS:77@ @X7F│ @X0F"
  190.             Continue
  191.         Endif
  192.         If (TSTRING004(INTEGER002) == "B") Then
  193.             PrintLn "@X70 @X78│@X74@POS:4@", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X70@POS:44@Out in DOS@POS:77@ @X7F│ @X0F"
  194.             Continue
  195.         Endif
  196.         If (TSTRING004(INTEGER002) == "P") Then
  197.             PrintLn "@X70 @X78│@X74@POS:4@", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X74@POS:44@Paging SysOp@X71@POS:69@", TSTRING007(INTEGER002), "@POS:69@@X70 @POS:73@Min@POS:77@ @X7F│ @X0F"
  198.             Continue
  199.         Endif
  200.         If (TSTRING004(INTEGER002) == "U") Then
  201.             TSTRING005(INTEGER002) = "Can't Chat Right Now"
  202.             PrintLn "@X70 @X78│@X74@POS:4@", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X79@POS:44@", TSTRING005(INTEGER002), "@X71@POS:69@", TSTRING007(INTEGER002), "@X70 @POS:73@Min@POS:77@ @X7F│ @X0F"
  203.             Continue
  204.         Endif
  205.         PrintLn "@X70 @X78│@X74@POS:4@", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X76@POS:44@", TSTRING005(INTEGER002), "@X71@POS:69@", TSTRING007(INTEGER002), "@X70 @POS:73@Min@POS:77@ @X7F│ @X0F"
  206.     Next
  207.     PrintLn "@X70 └@X78───────────────────────────────────────────────────────────────────────────@X70┘ @X0F"
  208.     PrintLn "@X08 v2.0a                                       COPYRIGHT (C) 1994 CHRIS MICHAELS"
  209.     PrintLn 
  210.     End
  211.     :LABEL003
  212.     For INTEGER002 = 1 To 2
  213.         Tokenize TSTRING003(INTEGER002)
  214.         INTEGER008 = TokCount()
  215.         For INTEGER009 = 1 To INTEGER008
  216.             GetToken TSTRING021(INTEGER009)
  217.             If (Right(TSTRING021(INTEGER009), 1) == ",") Then
  218.                 TSTRING021(INTEGER009) = Left(TSTRING021(INTEGER009), Len(TSTRING021(INTEGER009)) - 1)
  219.                 Continue
  220.             Endif
  221.             If (Right(TSTRING021(INTEGER009), 1) == ".") Then
  222.                 TSTRING021(INTEGER009) = Left(TSTRING021(INTEGER009), Len(TSTRING021(INTEGER009)) - 1)
  223.             Endif
  224.         Next
  225.         For INTEGER009 = 1 To INTEGER008
  226.             STRING022 = STRING022 + TSTRING021(INTEGER009) + " "
  227.             TSTRING021(INTEGER009) = ""
  228.         Next
  229.         TSTRING003(INTEGER002) = Left(STRING022, 13)
  230.         STRING022 = ""
  231.     Next
  232.     Return
  233.     :LABEL004
  234.     If (Left(TSTRING002(INTEGER002), INTEGER004) == Left(TSTRING005(INTEGER002), INTEGER004)) Then
  235.         TSTRING005(INTEGER002) = "@X7B" + Right(TSTRING005(INTEGER002), INTEGER003 - INTEGER004 - 3)
  236.         TSTRING005(INTEGER002) = LTrim(Left(TSTRING005(INTEGER002), 24), " ")
  237.     Endif
  238.     Return
  239.     :LABEL005
  240.     STRING009 = ""
  241.     STRING008 = ""
  242.     Tokenize TSTRING005(INTEGER002)
  243.     GetToken TSTRING010(INTEGER002)
  244.     GetToken TSTRING011(INTEGER002)
  245.     GetToken STRING014
  246.     GetToken TSTRING012(INTEGER002)
  247.     GetToken STRING014
  248.     GetToken TSTRING013(INTEGER002)
  249.     INTEGER005 = Len(TSTRING012(INTEGER002)) - 4
  250.     TSTRING012(INTEGER002) = Left(TSTRING012(INTEGER002), INTEGER005) + "K"
  251.     TSTRING005(INTEGER002) = TSTRING010(INTEGER002) + " " + TSTRING011(INTEGER002) + " " + TSTRING012(INTEGER002)
  252.     Return
  253.     :LABEL006
  254.     Select Case (TSTRING010(INTEGER002))
  255.         Case "(D)"
  256.             PrintLn "@X70 @X78│@POS:4@@X74", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X75@POS:44@", TSTRING005(INTEGER002), "@X71@POS:69@", TSTRING007(INTEGER002), "@X70 @POS:73@Min@POS:77@ @X7F│ @X0F"
  257.         Case "(U)"
  258.             PrintLn "@X70 @X78│@POS:4@@X74", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X75@POS:44@(U)ploading A File @XFC@X71@POS:69@", TSTRING007(INTEGER002), "@X70 @POS:73@Min@POS:77@ @X7F│ @X0F"
  259.         Case Else
  260.             PrintLn "@X70 @X78│@POS:4@@X74", STRING006, "@POS:8@@X70", Left(TSTRING002(INTEGER002), 19), " @X7E@POS:28@", TSTRING003(INTEGER002), " @X74@POS:44@Preparing File Transfer@POS:69@@X71", TSTRING007(INTEGER002), "@X70 @POS:73@Min@X7F@POS:77@ │ @X0F"
  261.     End Select
  262.     Return
  263.     :LABEL007
  264.     TSTRING007(INTEGER002) = LTrim(RTrim(TSTRING007(INTEGER002), " "), " ")
  265.     INTEGER006 = Len(TSTRING007(INTEGER002))
  266.     Select Case (INTEGER006)
  267.         Case 1
  268.             TSTRING007(INTEGER002) = "  " + TSTRING007(INTEGER002)
  269.         Case 2
  270.             TSTRING007(INTEGER002) = " " + TSTRING007(INTEGER002)
  271.         Case 3
  272.             TSTRING007(INTEGER002) = TSTRING007(INTEGER002)
  273.         Case 4
  274.             TSTRING007(INTEGER002) = "99+"
  275.     End Select
  276.     Return
  277.  
  278. ;------------------------------------------------------------------------------
  279. ;
  280. ; Usage report (before postprocessing)
  281. ;
  282. ; ■ Statements used :
  283. ;
  284. ;    1       End
  285. ;    78      Goto 
  286. ;    64      Let 
  287. ;    34      PrintLn 
  288. ;    42      If 
  289. ;    1       FOpen 
  290. ;    1       FClose 
  291. ;    2       FGet 
  292. ;    5       Gosub 
  293. ;    5       Return
  294. ;    2       Tokenize 
  295. ;    7       GetToken 
  296. ;    1       RdUNet 
  297. ;
  298. ;
  299. ; ■ Functions used :
  300. ;
  301. ;    1       /
  302. ;    20      +
  303. ;    7       -
  304. ;    32      ==
  305. ;    7       <
  306. ;    6       <=
  307. ;    14      >=
  308. ;    40      !
  309. ;    12      &&
  310. ;    6       ||
  311. ;    6       Len(
  312. ;    1       Mid()
  313. ;    28      Left()
  314. ;    3       Right()
  315. ;    4       LTrim()
  316. ;    8       RTrim()
  317. ;    1       Time()
  318. ;    1       PcbNode()
  319. ;    1       UN_Stat()
  320. ;    2       UN_Name()
  321. ;    1       UN_City()
  322. ;    1       UN_Oper()
  323. ;    1       Exist()
  324. ;    2       I2S()
  325. ;    1       S2I()
  326. ;    1       TokCount()
  327. ;
  328. ;------------------------------------------------------------------------------
  329. ;
  330. ; Analysis flags : No flag
  331. ;
  332. ;------------------------------------------------------------------------------
  333. ;
  334. ; Postprocessing report
  335. ;
  336. ;    6       For/Next
  337. ;    0       While/EndWhile
  338. ;    26      If/Then or If/Then/Else
  339. ;    3       Select Case
  340. ;
  341. ;------------------------------------------------------------------------------
  342. ;                 AEGiS Corp - Break the routines, code against the machines!
  343. ;------------------------------------------------------------------------------
  344.